home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / rich2tk.tcl.z / rich2tk.tcl
Text File  |  2002-07-08  |  12KB  |  429 lines
  1. #
  2. # rich2tk.tcl
  3. #
  4. # Written by Chris Garrigues <cwg@mcc.com> to be integrated into exmh
  5. #
  6.  
  7. proc Rich_Init {} {
  8.     global richCommands
  9.  
  10.     if [info exists richCommands] {
  11.     return
  12.     }
  13.  
  14.     set commands [concat [option get . richCommands {}] \
  15.              [option get . richUCommands {}]]
  16.     Exmh_Debug RichCommands $commands
  17.     if {[llength $commands] == 0} {
  18.     set commands {bold italic fixed smaller bigger underline
  19.               indent verbatim param excerpt center nl lt}
  20.     }
  21.  
  22.     set richCommands(vars) {}
  23.     foreach command $commands {
  24.     set func [option get . rich_$command {}]
  25.     if {$func != {}} {
  26.         set richCommands(command,$command) $func
  27.     }
  28.     set var [option get . richVar_$command {}]
  29.         if {$var != {}} {
  30.         set richCommands(var,$command) $var
  31.         if ![regexp $var $richCommands(vars)] {
  32.             lappend richCommands(vars) $var
  33.         }
  34.     }
  35.     set inc [option get . richInc_$command {}]
  36.     if {$inc != {}} {
  37.         set richCommands(inc,$command) $inc
  38.     }
  39.     }
  40.     if {$richCommands(vars) != {}} {
  41.     foreach var $richCommands(vars) {
  42.         set init [option get . richInit_$var {}]
  43.         if {$init != {}} {
  44.         set richCommands(init,$var) $init
  45.         }
  46.     }
  47.     } else {
  48.     set richCommands(vars)    {boldDepth italicDepth fixedDepth size \
  49.                  underDepth indent verbatim paramDepth \
  50.                  excerptDepth center}
  51.  
  52.     set richCommands(command,bold)        Rich_FontChange
  53.     set richCommands(var,bold)        boldDepth
  54.     set richCommands(command,italic)    Rich_FontChange
  55.     set richCommands(var,italic)        italicDepth
  56.     set richCommands(command,fixed)        Rich_FontChange
  57.     set richCommands(var,fixed)        fixedDepth
  58.     set richCommands(init,size)        120
  59.     set richCommands(command,smaller)    Rich_FontChange
  60.     set richCommands(var,smaller)        size
  61.     set richCommands(inc,smaller)        -20
  62.     set richCommands(command,bigger)    Rich_FontChange
  63.     set richCommands(var,bigger)        size
  64.     set richCommands(inc,bigger)        20
  65.  
  66.     set richCommands(var,underline)        underDepth
  67.     set richCommands(command,underline)    Rich_UnderlineChange
  68.  
  69.     set richCommands(var,indent)        indent
  70.     set richCommands(inc,indent)        4
  71.  
  72.     set richCommands(var,verbatim)        verbatim
  73.  
  74.     set richCommands(var,param)        paramDepth
  75.  
  76.     set richCommands(var,excerpt)        excerptDepth
  77.     set richCommands(command,excerpt)    Rich_ExcerptChange
  78.  
  79.     # We don't really do centering;     we just indent a bunch
  80.     set richCommands(var,center)        center
  81.  
  82.     # These are here for richtext compatibility
  83.     set richCommands(command,nl)        Rich_NewLine
  84.     set richCommands(command,lt)        Rich_LessThan
  85.     }
  86.     # Hack to get MIME preferences
  87.     global mime
  88.     if [info exists mime(fontSize)] {
  89.     set richCommands(init,size) $mime(fontSize)
  90.     }
  91. }
  92.  
  93. proc Rich_Display {w fileIO part type} {
  94.     global rich
  95.  
  96.     Rich_Init
  97.     catch {unset rich}
  98.     set rich(part) $part
  99.     Rich_DisplayString $w [read $fileIO] $type
  100. }
  101. proc Rich_DisplayString {w string type} { 
  102.     global rich richCommands mime
  103.  
  104.     set unknown {}
  105.     foreach var $richCommands(vars) {
  106.     if [info exists richCommands(init,$var)] {
  107.         set rich($var) $richCommands(init,$var)
  108.     } else {
  109.         set rich($var) 0
  110.     }
  111.     }
  112.     set rich(depth) 0
  113.     Rich_FontChange $w 1
  114.     while {[string length $string] > 0} {
  115.     if [regexp "^(\[^\n<]*)<<(.*)" $string \
  116.             match hdr tail] {
  117.         if $rich(paramDepth) {
  118.         append rich(param,[expr {$rich(depth) - 1}]) "$hdr<"
  119.         } else {
  120.         $w insert insert "$hdr<"
  121.         if {$rich(verbatim) || ($type == "richtext")} {
  122.             $w insert insert "<"
  123.         }
  124.         }
  125.         set string $tail
  126.     } else {
  127.         if [regexp "^(\[^\n<]*)<(\[^<>]*)>(.*)" $string \
  128.                match hdr command tail] {
  129.         set command [string tolower $command]
  130.         if $rich(paramDepth) {
  131.             append rich(param,[expr {$rich(depth) - 1}]) $hdr
  132.         } else {
  133.             $w insert insert $hdr
  134.         }
  135.         if $rich(verbatim) {
  136.             if {$command == {/verbatim}} {
  137.             set rich(verbatim) 0
  138.             } elseif $rich(paramDepth) {
  139.             $w append rich(param,[expr {$rich(depth) - 1}]) "<$command>"
  140.             } else {
  141.             $w insert insert "<$command>"
  142.             }
  143.         } else {        
  144.             set in [expr {[string index $command 0] != "/"}]
  145.             if $in {
  146.             incr rich(depth)
  147.             set rich(param,$rich(depth)) {}
  148.             } else {
  149.             incr rich(depth) -1
  150.             set command [string range $command 1 end]
  151.             }
  152.             if [info exists richCommands(var,$command)] {
  153.             if [info exists richCommands(inc,$command)] {
  154.                 set inc $richCommands(inc,$command)
  155.             } else {
  156.                 set inc 1
  157.             }
  158.             if !$in {
  159.                 set inc [expr -$inc]
  160.             }
  161.             incr rich($richCommands(var,$command)) $inc
  162.             }
  163.             if [info exists richCommands(command,$command)] {
  164.             $richCommands(command,$command) $w $in
  165.             } elseif ![info exists richCommands(var,$command)] {
  166.             lappend unknown $command
  167.             }
  168.         }
  169.         set string $tail
  170.         } else {
  171.         if [regexp "^(\[^\n<]*)\n(\n*)(.*)" $string \
  172.                match hdr crlfs tail] {
  173.             if $rich(paramDepth) {
  174.             append rich(param,[expr {$rich(depth) - 1}]) $hdr$crlfs
  175.             } else {
  176.             $w insert insert $hdr
  177.             if $rich(verbatim) {
  178.                 $w insert insert "\n$crlfs"
  179.             } elseif {$crlfs == ""} {
  180.                 $w insert insert " "
  181.             } else {
  182.                 if {$type == "richtext"} {
  183.                 for {set i 0} {$i < [string length $crlfs]} {incr i} {
  184.                     $w insert insert " "
  185.                 }
  186.                 } else {
  187.                 $w insert insert $crlfs
  188.                 Rich_Indentation $w
  189.                 }
  190.             }
  191.             }
  192.             set string $tail
  193.         } else {
  194.             if [regexp "^(\[^\n<]*<)(.*)" $string \
  195.                    match hdr tail] {
  196.             if $rich(paramDepth) {
  197.                 append rich(param,[expr {$rich(depth) - 1}]) $hdr
  198.             } else {
  199.                 $w insert insert $hdr
  200.             }
  201.             set string $tail
  202.             } else {
  203.             if $rich(paramDepth) {
  204.                 append rich(param,[expr {$rich(depth) - 1}]) $string
  205.             } else {
  206.                 $w insert insert $string
  207.             }
  208.             set string ""
  209.             }
  210.         }
  211.         }
  212.     }
  213.     }
  214.  
  215.     Rich_ClearColor $w
  216.     Rich_ClearExcerpt $w
  217.     set rich(boldDepth) 0
  218.     set rich(italicDepth) 0
  219.     set rich(fixedDepth) 1
  220.     set rich(size) 120
  221.     Rich_FontChange $w 0
  222.     Rich_ClearUnderline $w
  223.     $w insert insert \n
  224.     if {([string length $unknown] != 0) && $mime(showRichCmnds)} {
  225.     $w insert insert "Unknown richtext commands: $unknown\n"
  226.     }
  227.     Rich_ClearFontChanges $w
  228. }
  229.  
  230. proc Rich_NewLine {w in} {
  231.     $w insert insert \n
  232.     Rich_Indentation $w
  233. }
  234.  
  235. proc Rich_Indentation {w} {
  236.     global rich
  237.  
  238.     if $rich(center) {
  239.     $w insert insert "\t\t"
  240.     } else {
  241.     for {set i 0} {$i < $rich(indent)} {incr i} {
  242.         $w insert insert " "
  243.     }
  244.     }
  245. }
  246.  
  247. proc Rich_LessThan {w in} {
  248.     $w insert insert "<"
  249. }
  250.  
  251. proc Rich_FontChange {w in} {
  252.     global rich
  253.  
  254.     set newFont [Rich_GetFont $w $rich(boldDepth) $rich(italicDepth) \
  255.                   $rich(fixedDepth) $rich(size) \
  256.                   [Mime_GetCharset $w $rich(part)]]
  257.     if {![info exists rich(font,current)] ||
  258.     ($newFont != $rich(font,current))} {
  259.         if ![info exists rich(font,lastChange)] {
  260.         set rich(font,lastChange) 1.0
  261.         }
  262.         if {$rich(font,lastChange) != [$w index insert]} {
  263.         if [info exists rich(font,current)] {
  264.             set tagName [MimeLabel $rich(font,current) font]
  265.             MimeRememberTag $w $tagName
  266.             $w tag add $tagName $rich(font,lastChange) insert
  267.         }
  268.         }
  269.     set rich(font,current) $newFont
  270.     set tagName [MimeLabel $newFont font]
  271.     $w tag add $tagName end
  272.     $w tag configure $tagName -font $rich(font,current)
  273.     set rich(font,lastChange) [$w index insert]
  274.     MimeRaiseTag $w $tagName [MimeLabel $rich(part) part]
  275.     }
  276. }
  277.  
  278. proc Rich_ClearFontChanges {w} {
  279.     global rich
  280.  
  281.     if {$rich(font,lastChange) != [$w index insert]} {
  282.     if [info exists rich(font,current)] {
  283.         $w tag add Font=$rich(font,current) $rich(font,lastChange) insert
  284.         MimeRememberTag $w Font=$rich(font,current)
  285.     }
  286.     }
  287.     catch {unset rich(font,current)}
  288.     catch {unset rich(font,lastChange)}
  289. }
  290.  
  291. proc Rich_UnderlineChange {w in} {
  292.     global rich
  293.  
  294.     Rich_ClearUnderline $w
  295.     if {($rich(under,on) && ($rich(underDepth) == 0)) ||
  296.     (!$rich(under,on) && ($rich(underDepth) > 0))} {
  297.     set rich(under,lastChange) [$w index insert]
  298.     set rich(under,on) [expr !$rich(under,on)]
  299.     }
  300. }
  301.  
  302. proc Rich_ClearUnderline {w} {
  303.     global rich
  304.  
  305.     if ![info exists rich(under,on)] {
  306.     set rich(under,on) 0
  307.     }
  308.     if {[info exists rich(under,lastChange)] &&
  309.     ($rich(under,lastChange) != [$w index insert])} {
  310.     if $rich(under,on) {
  311.         $w tag add Underline $rich(under,lastChange) insert
  312.         $w tag configure Underline -underline 1
  313.         MimeRaiseTag $w Underline [MimeLabel $rich(part) part]
  314.     } else {
  315.         $w tag remove Underline $rich(under,lastChange) insert
  316.     }
  317.     }
  318. }
  319.  
  320. proc Rich_Color {w in} {
  321.     global rich
  322.  
  323.     if $in {
  324.     set depth $rich(colorDepth)
  325.     Rich_ClearColor $w $depth
  326.     set rich(colorStart,$depth) [$w index insert]
  327.     $w tag add colorDummy=$rich(depth) end
  328.     if {$depth == 1} {
  329.         MimeRaiseTag $w colorDummy=$depth [MimeLabel $rich(part) part]
  330.     } else {
  331.         MimeRaiseTag $w colorDummy=$depth colorDummy=[expr {$depth - 1}]
  332.     }
  333.     } else {
  334.     set color $rich(param,[expr {$rich(depth) + 1}])
  335.     regsub -nocase {^([0-9A-F][0-9A-F][0-9A-F][0-9A-F]),([0-9A-F][0-9A-F][0-9A-F][0-9A-F]),([0-9A-F][0-9A-F][0-9A-F][0-9A-F])$} $color {#\1\2\3} color
  336.     set depth [expr {$rich(colorDepth) + 1}]
  337.     set rich(colorTag,$depth) Color=$color
  338.  
  339.     $w tag add $rich(colorTag,$depth) end
  340.     $w tag lower $rich(colorTag,$depth)
  341.     $w tag add $rich(colorTag,$depth) $rich(colorStart,$depth) insert
  342.     $w tag configure $rich(colorTag,$depth) -foreground $color
  343.     MimeRaiseTag $w $rich(colorTag,$depth) dummy=$depth
  344.     $w tag delete dummy=$depth
  345.     Rich_ClearColor $w [expr {$depth + 1}]
  346.     set rich(colorEnd,$depth) [$w index insert]
  347.     }
  348. }
  349.  
  350. proc Rich_ClearColor {w {depth default}} {
  351.     global rich
  352.  
  353.     if [info exists rich(colorDepth)] {
  354.     if [regexp {default} $depth] {
  355.         set depth [expr {$rich(colorDepth) + 1}]
  356.     }
  357.     if [info exists rich(colorTag,$depth)] {    
  358.         $w tag remove $rich(colorTag,$depth) $rich(colorEnd,$depth) insert
  359.         unset rich(colorEnd,$depth) 
  360.         unset rich(colorTag,$depth)
  361.     }
  362.     }
  363. }
  364.  
  365. proc Rich_ExcerptChange {w in} {
  366.     global mimeHdr rich
  367.  
  368.     if $in {
  369.     set depth $rich(excerptDepth)
  370.     Rich_ClearExcerpt $w $depth
  371.     set rich(excerptStart,$depth) [$w index insert]
  372.     set color $mimeHdr($rich(part),color)
  373.     for {set i 0} {$i < $depth} {incr i} {
  374.         set color [MimeDarkerColor $w $color]
  375.     }
  376.     set rich(excerptTag,$depth) Background=$color
  377.     if ![regexp $rich(excerptTag,$depth) [$w tag names]] {
  378.         $w tag add $rich(excerptTag,$depth) end
  379.         $w tag lower $rich(excerptTag,$depth)
  380.     }
  381.     if {$depth == 1} {
  382.         MimeRaiseTag $w $rich(excerptTag,$depth) \
  383.              [MimeLabel $rich(part) part]
  384.     } else {
  385.         MimeRaiseTag $w $rich(excerptTag,$depth) \
  386.              $rich(excerptTag,[expr {$depth - 1}])
  387.     }
  388.     $w tag configure $rich(excerptTag,$depth) -background $color
  389.     } else {
  390.     set depth [expr {$rich(excerptDepth) + 1}]
  391.     $w tag add $rich(excerptTag,$depth) $rich(excerptStart,$depth) insert
  392.     set rich(excerptEnd,$depth) [$w index insert]
  393.     Rich_ClearExcerpt $w [expr {$depth + 1}]
  394.     unset rich(excerptStart,$depth)
  395.     }
  396. }
  397.  
  398. proc Rich_ClearExcerpt {w {depth default}} {
  399.     global rich
  400.  
  401.     if [regexp {default} $depth] {
  402.     set depth [expr {$rich(excerptDepth) + 1}]
  403.     }
  404.     if [info exists rich(excerptTag,$depth)] {
  405.     $w tag remove $rich(excerptTag,$depth) $rich(excerptEnd,$depth) insert
  406.     unset rich(excerptTag,$depth)
  407.     unset rich(excerptEnd,$depth)
  408.     }
  409. }
  410.  
  411. proc Rich_GetFont {w bold italic fixed size charset} {
  412.     if {$bold > 0} {
  413.     set weight bold
  414.     } else {
  415.     set weight medium
  416.     }
  417.     if {$italic > 0} {
  418.     set slant i
  419.     } else {
  420.     set slant r
  421.     }
  422.     if {$fixed > 0} {
  423.     set fontSet fixed
  424.     } else {
  425.     set fontSet proportional
  426.     }
  427.     Mime_GetFont $w $weight $slant $fontSet $size $charset
  428. }
  429.